package DateTime::Cursor;

use warnings;
use strict;
use Carp;

use version; our $VERSION = qv('0.0.1');
use base qw( Exporter );
our @EXPORT = qw( new get_supported_intervals);

use DateTime;
use Scalar::Util qw(blessed);
use Class::Std;
use Class::Std::Utils;
use Data::Dumper;

my %supported_intervals = ( years => 1,
                       months  => 1,
                       days    => 1,
                       hours   => 1,
                       minutes => 1,
                       seconds => 1,
                       nanoseconds => 1); 

sub get_supported_intervals {
    return keys %supported_intervals;
}

sub _get_duration_from_datetime {
    my ($datetime, $interval, $interval_value) = @_;
    confess "undefined datetime" unless defined $datetime;
    confess "undefined interval" unless defined $interval;
    confess "undefined interval_value" unless defined $interval_value;
    my $duration;
    eval {
        $duration = DateTime::Duration->new($interval => $interval_value);
    };
    confess "error while getting duration from datetime $datetime with interval $interval and " .
        "interval value $interval_value : $@" unless ((! defined $@) or ("" eq "$@"));
    return $duration;
}

sub _get_interval_value_from_datetime {
    my ($datetime, $interval) = @_;
    confess "one or more arguments are undefined" unless defined $datetime and defined $interval;
    confess "datetime argument is not blessed : $datetime" unless
        (blessed $datetime) ne "";        
    confess "datetime argument is not an instance of DateTime : $datetime"
        unless $datetime->isa('DateTime');
    confess "interval argument is not supported : $interval"
        unless exists $supported_intervals{$interval};
    if ('years' eq $interval) {
        return $datetime->year();
    } elsif ('months' eq $interval) {
        return $datetime->month();
    } elsif ('days' eq $interval) {
        return $datetime->day();
    } elsif ('hours' eq $interval) {
        return $datetime->hour();
    } elsif ('minutes' eq $interval) {
        return $datetime->minute();
    } elsif ('seconds' eq $interval) {
        return $datetime->second();
    } elsif ('nanoseconds' eq $interval) {
        return $datetime->nanosecond();
    } else {
        confess "Unsupported interval : $interval";
    }
}

sub _offset_datetime {
    my ($datetime, $interval, $offset) = ($_[0], $_[1], $_[2]);
    confess "undefined datetime" unless defined $datetime;
    confess "undefined interval" unless defined $interval;
    confess "undefined offset" unless defined $offset;
    my $interval_value = _get_interval_value_from_datetime($datetime, $interval);
    my $duration = _get_duration_from_datetime($datetime,
                                               $interval,
                                               $offset);
    #carp "duration=" . Dumper($duration) . " , offset=$offset";
    $datetime->add_duration($duration);
    #carp "resultant datetime=" . $datetime->iso8601();
    return $datetime;
}

sub _offset_cursor {
    my ($cursor, $offset) = ($_[0], $_[1]);
    confess "undefined cursor" unless defined $cursor;
    if (defined $offset) {
        my $new_pivot = _offset_datetime($cursor->get_pivot(),
                                         $cursor->get_interval(),
                                         $offset);
        confess "undefined new pivot" unless defined $new_pivot;
        $cursor->set_pivot($new_pivot);
    }
    return $cursor;
}

sub _compare_as_number {
    my ($cursor, $other) = ($_[0], $_[1]);
    confess "undefined cursor" unless defined $cursor;
    confess "cant compare as number with an undefined other" unless defined $other;
    my $pivot_cmp = $cursor->_pivot_comparison($other);
    if ("" ne $pivot_cmp) {
        return $pivot_cmp;
    } else {
        return ($cursor->as_number() <=> $other);
    }
}

sub _compare_as_string {
    my ($cursor, $other) = ($_[0], $_[1]);
    confess "undefined cursor" unless defined $cursor;
    confess "cant compare as string with an undefined other" unless defined $other;
    my $pivot_cmp = $cursor->_pivot_comparison($other);
    if ("" ne $pivot_cmp) {
        return $pivot_cmp;
    } else {
        return (_as_string($cursor) cmp $other);
    }
}

sub _as_number {
    my $cursor= $_[0];
    return $cursor->get_pivot()->epoch();
}

sub _as_string {
    my $cursor = $_[0];
    my $pivot = $cursor->get_pivot();
    my $formatter = $cursor->get_formatter();
    if (defined $formatter) {
        $pivot->set_formatter($formatter);
        return "$pivot";
    } else {
        return $pivot->iso8601();
    }
}

sub _as_boolean {
    my $cursor = $_[0];
    return 1;
}

# inside out object implementation here
{
    my %pivot_of : ATTR;  # the seed value for the cursor object
    my %interval_of : ATTR; # the interval for iterating
    my %timezone_of : ATTR; # the display time zone of the pivot
    my %formatter_of : ATTR; # the DateTime::Format object used for stringification
    
    sub BUILD {
        my ($self, $ident, $arg_ref) = ($_[0], $_[1], $_[2]);
        
        my $pivot_arg;
        if (exists $arg_ref->{'pivot'}) {
            $pivot_arg = $arg_ref->{'pivot'};
            confess "undefined pivot arg" unless defined $pivot_arg;
        } else {
            $pivot_arg = DateTime->now();
        }
        $self->set_pivot($pivot_arg);
        
        my $interval_arg;
        if (exists $arg_ref->{'interval'}) {
            $interval_arg = $arg_ref->{'interval'};
            confess "undefined interval arg" unless defined $interval_arg;
        } else {
            $interval_arg = 'days';
        }
        $self->set_interval($interval_arg);
        
        # optional args which override the default settings from pivot
        my $timezone_arg;
        if (exists $arg_ref->{'timezone'}) {
            $timezone_arg = $arg_ref->{'timezone'};
            confess "undefined timezone arg" unless defined $timezone_arg;
        } else {
            $timezone_arg = $pivot_arg->time_zone();
        }
        $self->set_timezone($timezone_arg);
        
        my $formatter_arg;
        if (exists $arg_ref->{'formatter'}) {
            $formatter_arg = $arg_ref->{'formatter'};
        } else {
            $formatter_arg = $pivot_arg->formatter();
        }
        $self->set_formatter($formatter_arg);
        return;
    }

    sub clone {
        my $self = $_[0];
        my $cloned_self = DateTime::Cursor->new({pivot => $self->get_pivot()});
        $cloned_self->set_formatter($self->get_formatter());
        $cloned_self->set_interval($self->get_interval());
        $cloned_self->set_timezone($self->get_timezone());
        return $cloned_self;
    }
    
    sub set_formatter {
        my ($self, $new_formatter) = ($_[0], $_[1]);
        # CAVEAT:
        # Because this subroutine is used by the inside out object plumbing
        # it has to be able to take an empty string / undef arg for the
        # cases where its called by the hash driven constructor pattern
        # of the object.
        if (defined $new_formatter and "" ne $new_formatter) {
            # CAVEAT:
            # We have to do this funky isa because the DateTime::Format::Strptime module
            # doesnt appear as a subclass of DateTime::Format during an isa->(...)
            my $blessed_class = blessed $new_formatter;
            confess "formatter is not an instance of DateTime::Format : $new_formatter" unless
                (("" ne $blessed_class) and ($blessed_class =~ /DateTime::Format::.+/));
            $formatter_of{ident $self} = $new_formatter;
        } else {
            # CAVEAT:
            # Due the lack of a "default" format class, have to 
            # set the format back to undefined so that the pivot->iso8601()
            # method will be used instead of an outboard format
            delete $formatter_of{ident $self};            
        }
        return;
    }
    
    sub get_formatter {
        my $self = $_[0];
        return $formatter_of{ident $self};
    }
    
    sub set_timezone {
        my ($self, $new_timezone) = ($_[0], $_[1]);
        confess "Undefined timezone" unless defined $new_timezone;
        confess "timezone is not an instance of DateTime::TimeZone : $new_timezone" unless
            ((blessed $new_timezone) and ($new_timezone->isa('DateTime::TimeZone')));
        $timezone_of{ident $self} = $new_timezone;
        return;
    }
    
    sub get_timezone {
        my $self = $_[0];
        return $timezone_of{ident $self};
    }
    
    sub set_pivot {
        my ($self, $new_pivot) = ($_[0], $_[1]);
        confess "Undefined pivot" unless defined $new_pivot;
        confess "Pivot is not an instance of DateTime : $new_pivot" unless
            ((blessed $new_pivot) and ($new_pivot->isa('DateTime')));
        my $cloned_pivot = $new_pivot->clone();
        $pivot_of{ident $self} = $cloned_pivot;
        $pivot_of{ident $self}->set_time_zone('UTC');
        return;
    }
    
    sub get_pivot {
        my $self = $_[0];
        my $pivot = $pivot_of{ident $self};
        confess "Undefined pivot" unless defined $pivot;
        my $cloned_pivot = $pivot->clone();
        $cloned_pivot->set_time_zone($timezone_of{ident $self});
        $cloned_pivot->set_formatter($formatter_of{ident $self});
        return $cloned_pivot;
    }

    sub set_interval {
        my($self, $new_interval) = ($_[0], $_[1]);
        confess "Undefined interval" unless defined $new_interval;
        confess "Tried to set interval that was not in supported set, (" .
            join(",", sort keys %supported_intervals) . ") : $new_interval"
            unless exists $supported_intervals{$new_interval};
        $interval_of{ident $self} = $new_interval;
        return;
    }
   
    sub get_interval {
        my $self = $_[0];
        return $interval_of{ident $self};
    }
    
    sub _pivot_comparison :PRIVATE {
        my ($self, $other) = ($_[0], $_[1]);
        confess "undefined other" unless defined $other;
        my $return_cmp = "";
        if ("" eq $other) {
            $return_cmp = _as_string($self) cmp "";    
        } else {
            my $blessed_other = blessed $other;
            if ($blessed_other ne "") {
                if ($other->isa('DateTime::Cursor')) {
                    my $self_pivot = $pivot_of{ident $self};
                    my $other_pivot = $pivot_of{ident $other};
                    $return_cmp = DateTime->compare($self_pivot, $other_pivot);                 
                } elsif ($other->isa('DateTime')) {
                    my $self_pivot = $pivot_of{ident $self};
                    $return_cmp = DateTime->compare($self_pivot, $other);
                }
            }
        }
        return $return_cmp;
    }
    
    sub add {
        my ($self, $other) = ($_[0], (int $_[1]));
        my $cloned_self = $self->clone();        
        confess "undefined clone of self" unless defined $cloned_self;
        #carp "add by offsetting with $other";
        return _offset_cursor($cloned_self, $other);
    }
    
    sub subtract {
        my ($self, $other) = ($_[0], (int $_[1]));
        my $cloned_self = $self->clone();
        confess "undefined clone of self" unless defined $cloned_self;
        my $inverse_other = (-1 * $other);
        #carp "subtract by offsetting with $inverse_other";
        return _offset_cursor($cloned_self, $inverse_other);
    }

    sub scroll_forward {
       my ($self, $offset) = ($_[0], 1);
       if (defined $_[1]) {
         my $value = int $_[1];
         $offset = abs $value;
       }
       #carp "scroll forward $offset\n";
       _offset_cursor($self, $offset) unless (0 == $offset);
       return;
    }

    sub scroll_backward {
       my ($self, $offset) = ($_[0], -1);
       if (defined $_[1]) {
         my $value = int $_[1];
         $offset = abs $value;
         $offset *= -1;
       }
       #carp "scroll back $offset\n"; 
       _offset_cursor($self, $offset) unless (0 == $offset);
       return;
    }

    use overload (
        '0+'    => \&_as_number,
        'bool'  => \&_as_boolean,
        q{""}   => \&_as_string,
        '<=>' => \&_compare_as_number,
        'cmp' => \&_compare_as_string,
        '+' => \&add,
        '-' => \&subtract,
        fallback => 1
    );
    
}


1; # Magic true value required at end of module
__END__

=head1 NAME

DateTime::Cursor - Cursor for traversing timelines.


=head1 VERSION

This document describes DateTime::Cursor version 0.0.1


=head1 SYNOPSIS

	use DateTime;
	use DateTime::Cursor;

	# use default iso8605 stringified format, and iterate
	# the cursor at one month intervals for 12 months
	my $default_cursor = new DateTime::Cursor({ 'interval' => 'days'});
	foreach(1 .. 12) {
		print "next value for cursor is $default_cursor\n";
		$default_cursor->scroll_forward();
	}
    
	# see what the time is in Denver    
	use DateTime::TimeZone;    
	my $denver_tz = DateTime::TimeZone->new({name => 'America/Denver'});
	my $denver_tz_cursor = new DateTime::Cursor({'timezone' => $denver_tz});
	print "Current time in Denver is $denver_tz_cursor\n";

	# stringify the cursor with the mail format
	use DateTime::Format::Mail;
	my $mail_format = DateTime::Format::Mail->new();
	my $mail_formatted_cursor = new DateTime::Cursor({'formatter' => $mail_format});
	print "Cursor in mail format $mail_formatted_cursor\n";
    

=for author to fill in:
	Brief code example(s) here showing commonest usage(s).
	This section will be as far as many users bother reading
	so make it as educational and exeplary as possible.


=head1 DESCRIPTION

=for author to fill in:
    Write a full description of the module and its features here.
    Use subsections (=head2, =head3) as appropriate.

This module is intended to provide a simplistic cursor for use with
the C<DateTime> module produced by the Perl DateTime Project.  For more
information about the Perl DateTime Project, please see L<http://datetime.perl.org/>.

=head1 INTERFACE 

An object of this class represents a cursor for traversing timelines using an
instance of the class C<DateTime> as the pivot.


=head2 Module Subroutines

=over 4

=item * get_supported_intervals()

This subroutine returns a list of the intervals supported by the C<DateTime::Cursor> class:
"years", "months", "days", "hours", "minutes", "seconds", "nanoseconds".

Please see the C<DateTime> module for further documentation on the meaning of these intervals.

=back


=head2 Class Methods

=over 4

=item * new(...)

The constructor method for the class takes a reference to a hash as its sole argument.

The hash may have any or all of the following keys: 

=over 8

=item * pivot

See documentation for the C<DateTime::Cursor::set_pivot()> method.

=item * interval

See documentation for the C<DateTime::Cursor::set_interval()> method.

=item * timezone

See documentation for the C<DateTime::Cursor::set_timezone()> method.

=item * formatter

See documentation for the C<DateTime::Cursor::set_formatter()> method.

=back

=item * set_pivot(...)

Sets the pivot for the cursor instance.  It must be an instance of the C<DateTime> class.
A defensive copy will be made, and that copy will be the one used
in the instance of C<DateTime::Cursor>.

=item * get_pivot()

Returns an instance of C<DateTime> which is a copy of the one used as a pivot by
the instance of C<DateTime::Cursor>.

=item * set_interval(...)

Sets the time interval for the cursor instance. Takes a single string as an
argument, and it must be one of the supported interval values. For more details, 
see the documentation for the C<DateTime::Cursor::get_supported_intervals()> method above.

=item * get_interval(...)

Returns a string representing the interval currently used by the C<DateTime::Cursor>. 
For more details, see the documentation for the C<DateTime::Cursor::get_supported_intervals()> method above.

=item * set_timezone(...)

Sets the time zone for the cursor instance.  Takes a single argument which must
be an instance of C<DateTime::TimeZone>.

=item * get_timezone()

Returns the instance of C<DateTime::TimeZone> used by the cursor.

=item * set_formatter(...)

Sets the formatter to be used for the cursor instance.  Takes a single argument which
must be an instance of C<DateTime::Format>.

=item * get_formatter(...)

Gets the instance of C<DateTime::Format> used by the cursor.

=item * clone()

Returns a new cursor instance which is a clone of the cursor instance upon
which this method was called.

=item * scroll_forward(...)

Moves the cursor forward to the I<next> interval in time, based on its current
interval setting.  Takes an optional single argument which must be an integer
representing the number of intervals to scroll forward.

=item * scroll_backward(...)

Moves the cursor backward to the I<previous> interval in time, based on its
current interval setting.  Takes an optional single argument which must be
an integer representing the number of intervals to scroll backwards.

=item * add(...)

Behaves according the Perl standard for the C<+> operator.
For more details, please see the subsection on operator
overloading for cursors.

=item * subtract(...)

Behaves according to the Perl standard for the C<-> operator.
For more details, please see the subsection on operator
overloading for cursors.

=back 

=head2 Operator Overloading

The C<fallback> feature of the C<overload> module is being to "magically
autogenerate" operator overloading where it is not explicitly done by the cursor
module.

Please see the documentation for the C<overload> module for more information
on the overloading behaviors where C<fallback> is set to C<TRUE>.

Here are the explicit overloads:

=over 8

=item * Arithmetic operators : addition (+) and subtraction (-)

The arithmetic operators expect integers and/or integer context C<DateTime::Cursor> objects as its
operands.

=item * Comparison operators : numeric (<=>) and string (cmp)

The numeric comparison operator (<=>) expects integers and/or integer context C<DateTime::Cursor> objects as its
operands.

The string comparison operator (cmp) expects strings and/or stringified C<DateTime::Cursor>
objects as its operands.

=item * Boolean, string and numeric conversion operations

Boolean conversion is overloaded so that an instance of the C<DateTime::Cursor> is always
considered C<TRUE> in a boolean context.

String conversion is overloaded so that an instance of the C<DateTime::Cursor> is
stringified using it's C<DateTime::Format> formatter, or the C<DateTime::iso8601()>
method of it's pivot if no formatter was set for the cursor.

Numeric conversion is overloaded so that an instance of the C<DateTime::Cursor> is
numerified by using the value returned by it's pivot's C<DateTIme::epoch()> method.

=back

=head1 DIAGNOSTICS

=for author to fill in:
    List every single error and warning message that the module can
    generate (even the ones that will "never happen"), with a full
    explanation of each problem, one or more likely causes, and any
    suggested remedies.

=over

=item C<< error while getting duration from datetime %s with interval %s and interval value %s : %s >>

This an internal error in the cursor, where it tried to create an instance of C<DateTime::Duration> and a
fatal error was thrown from the C<new()> subroutine of C<DateTime::Duration>.

=item C<< formatter is not an instance of DateTime::Format : %s >>

The argument to the C<DateTime::Cursor::set_formatter()> method must be an instance of, or a 
descendant of the C<DateTime::Format> class.

=item C<< timezone is not an instance of DateTime::TimeZone : %s >>

The argument passed to the C<DateTime::Cursor::set_timezone()> method must be an instance of, or a child
of the C<DateTime::TimeZone> class.

=item C<< Pivot is not an instance of DateTime : %s >>

The argument passed to the C<DateTime::Cursor::set_pivot()> method must be an instance of, or a child of
the C<DateTime> class.

=back

=head1 CONFIGURATION AND ENVIRONMENT

DateTime::Cursor requires no configuration files or environment variables.


=head1 DEPENDENCIES

This module depends primarily on modules produced by the Perl DateTime project:
C<DateTime>, C<DateTime::Duration>, C<DateTime::TimeZone>, C<DateTime::Format>.

Please see L<http://datetime.perl.org/> for details on this project.

=head1 INCOMPATIBILITIES

=for author to fill in:
    A list of any modules that this module cannot be used in conjunction
    with. This may be due to name conflicts in the interface, or
    competition for system or program resources, or due to internal
    limitations of Perl (for example, many modules that use source code
    filters are mutually incompatible).

None reported.


=head1 BUGS AND LIMITATIONS

=for author to fill in:
    A list of known problems with the module, together with some
    indication Whether they are likely to be fixed in an upcoming
    release. Also a list of restrictions on the features the module
    does provide: data types that cannot be handled, performance issues
    and the circumstances in which they may arise, practical
    limitations on the size of data sets, special cases that are not
    (yet) handled, etc.

No bugs have been reported.

Please report any bugs or feature requests to
C<bug-datetime-cursor@rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org>.


=head1 AUTHOR

Phil Chandler   C<< <igor.no.12@gmail.com> >>

Serge Madenian

=head1 LICENCE AND COPYRIGHT

Copyright (c) 2008, Serge Madenian and Phil Chandler  C<< <igor.no.12@gmail.com> >>. All rights reserved.

This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.


=head1 DISCLAIMER OF WARRANTY

BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
NECESSARY SERVICING, REPAIR, OR CORRECTION.

IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.
